home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Demos / Widget / Whscale.stklos < prev    next >
Encoding:
Text File  |  1995-09-13  |  1.4 KB  |  37 lines
  1. ;;;;
  2. ;;;; STk adaptation of the Tk widget demo.
  3. ;;;;
  4. ;;;; This demonstration script shows an example with a horizontal scale.
  5. ;;;;
  6.  
  7. (define (demo-hscale)
  8.   
  9.   (define (set-width! c poly line width)
  10.     (let* ((width (+ width 21))
  11.        (x2     (max (- width 30) 21)))
  12.       (set! (coords poly) (list 20 15 20 35 x2 35 x2 45 width 25 x2 5 x2 15 20 15))
  13.       (set! (coords line) (list 20 15 20 35 x2 35 x2 45 width 25 x2 5 x2 15 20 15)))
  14.     )
  15.     
  16.  
  17.   (let* ((w (make-demo-toplevel  "hscale"
  18.                  "Horizontal Scale Demonstration"
  19.                  "An arrow and a horizontal scale are displayed below.  If you click or drag mouse button 1 in the scale, you can change the length of the arrow."))
  20.      (f    (make <Frame> :parent w :border-width 10))
  21.      (c    (make <Canvas> :parent f :width 50 :height 50 :border-width 0 
  22.              :highlight-thickness 0))
  23.      (poly  (make <Polygon> :parent c :coords '(0 0 1 1 2 2) 
  24.               :fill "DeepSkyBlue3"))
  25.      (line  (make <Line> :parent c :coords '(0 0 1 1 2 2 0 0) :fill "black"))
  26.      (s     (make <Scale> :parent f :orientation "horizontal" :scale-length 284 
  27.               :from 0 :to 250
  28.               :tick-interval 50 :value 75
  29.               :command (lambda (v) (set-width! c poly line v)))))
  30.     
  31.     (pack f :side "top" :fill "x")
  32.     (pack s :side "left" :side "bottom" :expand #t :anchor "n")
  33.     (pack c :side "left" :side "top" :expand #t :anchor "s" :fill "x" :padx 15)))
  34.  
  35.     
  36.  
  37.